Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d2/sysid47.arc/SYSID.INC

Text File | 1989-12-17 | 58.8 KB | 2,641 lines

(*
**    SYSID.INC
**
**    Version 4.7
**
**    The functions and procedures for SYSID.PAS
**
**    Steve Grant
**    Long Beach, CA
**    July 31, 1989
*)

procedure caption1(a : string);

begin
    textcolor(lightgray);
    write(a);
    textcolor(lightgreen)
end;

procedure caption2(a : string);

const
    capterm = ': ';

var
    i : byte;

begin
    i := length(a);
    while (i > 0) and (a[i] = ' ') do
        dec(i);
    insert(capterm, a, i + 1);
    caption1(a)
end;

function nocarry : boolean;

begin
    nocarry := regs.flags and fcarry = $0000
end;

function hex(a : word; b : byte) : string;

const
    digit : array[$0..$F] of char = '0123456789ABCDEF';

var
    i : byte;
    xstring : string;

begin
    xstring := '';
    for i := 1 to b do begin
        insert(digit[a and $000F], xstring, 1);
        a := a shr 4
    end;
    hex := xstring
end;

procedure unknown(a : string; b : word; c : byte);

begin
    writeln('(unknown', ' ', a, ' ', hex(b, c), ')')
end;

procedure caption3(a : string);

begin
    caption2('  ' + a)
end;

procedure yesorno1(a : boolean);

begin
    if a then
        write('yes')
    else
        write('no ')
end;

procedure yesorno2(a : boolean);

begin
    yesorno1(a);
    writeln
end;

procedure dontknow1;

begin
    write('(unknown)')
end;

procedure dontknow2;

begin
    dontknow1;
    writeln
end;

procedure pause1;

var
    xbyte : byte;
    xchar : char;

begin
    if wherey + hi(windmin) > hi(windmax) then begin
        xbyte := textattr;
        textcolor(green);
        write('(continued)');
        repeat
            xchar := readkey
        until not keypressed;
        clrscr;
        writeln('(continued)');
        textattr := xbyte
    end
end;

procedure CPUID(var a : cpu_info_t);

external;

procedure segofs1(a, b : word);

begin
    write(hex(a, 4), ':', hex(b, 4))
end;

procedure segofs2(a, b : word);

begin
    segofs1(a, b);
    writeln
end;

function showchar(a : char) : char;

begin
    if a in pchar then
        showchar := a
    else
        showchar := '.'
end;

function bin4(a : byte) : string;

const
    digit : array[0..1] of char = '01';

var
    xstring : string;
    i : byte;

begin
    xstring := '';
    for i := 3 downto 0 do begin
        insert(digit[a mod 2], xstring, 1);
        a := a shr 1
    end;
    bin4 := xstring
end;

procedure offoron(a : boolean);

begin
    if a then
        write('on')
    else
        write('off')
end;

procedure zeropad(a : word);

begin
    if a < 10 then
        write('0');
    write(a)
end;

function cbw(a, b : byte) : word;

begin
    cbw := b shl 8 + a
end;

function bin16(a : word) : string;

function bin8(a : byte) : string;

begin
    bin8 := bin4(a shr 4) + '_' + bin4(a and $0F)
end;

begin (* function bin16 *)
    bin16 := bin8(hi(a)) + '_' + bin8(lo(a))
end;

procedure drvname(a : byte);

begin
    write(chr(ord('A') + a), ': ')
end;

procedure media(a : byte);

procedure diskette(a, b : byte);

begin
    writeln('diskette (', a, '-sided, ', b, ' sectors)')
end;

begin (* procedure media *)
    caption3('Media');
    case a of
        $FF : diskette(2, 8);
        $FE : diskette(1, 8);
        $FD : diskette(2, 9);
        $FC : diskette(1, 9);
        $F9 : diskette(2, 15);
        $F8 : writeln('fixed disk')
        else
            unknown('media', a, 2)
    end
end;

procedure pause2;

var
    xbyte : byte;
    xchar : char;

begin
    xbyte := textattr;
    textcolor(green);
    write('(continued)');
    repeat
        xchar := readkey
    until not keypressed;
    textattr := xbyte
end;

function diskread(drive : byte; starting_sector, number_of_sectors : word
    ; var buffer) : word;

external;

(****************************************************************************)

procedure init;

const
    qversion = 'Version 4.7';

var
    xint : integer;

procedure rjustify(a : string);

begin
    gotoxy(1 + lo(windmax) - length(a), wherey);
    write(a)
end;

procedure border;

const
    ch = '═';

var
    i : byte;

begin
    for i := 1 to twidth - 1 do
        write(ch)
end;

begin (* procedure init *)
    attrsave := textattr;
    with regs do begin
        AH := $0F;
        intr($10, regs);
        twidth := AH;
        vidpg := BH;
        intr($11, regs);
        equip := AX;
        intr($12, regs);
        DOSmem := longint(AX) shl 10;
        AH := $19;
        MSDOS(regs);
        currdrv := AL;
        AH := $34;
        MSDOS(regs);
        DOScseg := ES;
        DOScofs := BX;
        AX := $3700;
        MSDOS(regs);
        switchar := chr(DL);
        AX := $3800;
        DS := seg(country);
        DX := ofs(country);
        MSDOS(regs);
        ccode := BX;
        AH := $52;
        MSDOS(regs);
        devseg := ES;
        devofs := BX
    end;
    detectgraph(graphdriver, xint);
    if (graphdriver = EGA) or (graphdriver = MCGA)
        or (graphdriver = VGA) then
        with regs do begin
            AX := $1130;
            BH := $00;
            intr($10, regs);
            tlength := DL + 1
        end
    else
        tlength := 25;
    for i := $00 to $FF do
        getintvec(i, intvec[i]);
    intvec[$00] := saveint00;
    intvec[$02] := saveint02;
    intvec[$1B] := saveint1B;
    intvec[$23] := saveint23;
    intvec[$24] := saveint24;
    intvec[$34] := saveint34;
    intvec[$35] := saveint35;
    intvec[$36] := saveint36;
    intvec[$37] := saveint37;
    intvec[$38] := saveint38;
    intvec[$39] := saveint39;
    intvec[$3A] := saveint3A;
    intvec[$3B] := saveint3B;
    intvec[$3C] := saveint3C;
    intvec[$3D] := saveint3D;
    intvec[$3E] := saveint3E;
    intvec[$3F] := saveint3F;
    intvec[$75] := saveint75;
    dirsep := ['\'];
    if switchar <> '/' then
        dirsep := dirsep + ['/'];
    textbackground(black);
    window(1, 1, twidth, tlength);
    clrscr;
    textcolor(green);
    write('SYSID');
    textcolor(lightgray);
    write(' - System description for IBM PC''s and compatibles');
    rjustify(qversion);
    writeln;
    border;
    gotoxy(1, tlength - 1);
    border;
    writeln;
    write('Page ');
    x1 := wherex + lo(windmin);
    write(pgmax, ' of ', pgmax);
    textcolor(green);
    rjustify('PgDn PgUp Home End Esc');
    x2 := wherex + lo(windmin);
    pg := 1
end;

(****************************************************************************)

procedure page_01;

const
    BIOScseg = $C000;
    BIOSext = $AA55;
    PCROMseg = $F000;

var
    xbool : boolean;
    xbyte : byte;
    xchar : char;
    xlong : longint;
    xword1 : word;
    xword2 : word;

function BIOSscan(a, b, c : word; var d : word) : boolean;

const
    max = 3;
    notice : array[1..max] of string = ('(C)', 'COPR.', 'COPYRIGHT');

var
    i : 1..max;
    len : byte;
    target : string;
    xbool : boolean;
    xlong : longint;
    xword : word;

function scan(a : string; b, c, d : word; var e : word) : boolean;

var
    i : longint;
    j : byte;
    len : byte;
    xbool1 : boolean;
    xbool2 : boolean;

begin
    i := c;
    len := length(a);
    xbool1 := false;
    repeat
        if i <= longint(d) - len + 1 then begin
            j := 0;
            xbool2 := false;
            repeat
                if j < len then
                    if upcase(chr(mem[b : i + j])) = a[j + 1] then
                        inc(j)
                    else begin
                        xbool2 := true;
                        inc(i)
                    end
                else begin
                    xbool2 := true;
                    xbool1 := true;
                    e := i;
                    scan := true
                end
            until xbool2
        end else begin
            xbool1 := true;
            scan := false
        end
    until xbool1
end;

begin (* function BIOSscan *)
    xlong := c;
    xbool := false;
    for i := 1 to max do begin
        target := notice[i];
        len := length(target);
        if xbool then
            xlong := longint(xword) - 2 + len;
        if (xlong >= b) and (xlong <= c) and (scan(target, a, b, xlong, xword))
            then
            xbool := true
    end;
    if xbool then begin
        while (xword > b) and (chr(mem[a : xword - 1]) in pchar) do
            dec(xword);
        d := xword
    end;
    BIOSscan := xbool
end;

procedure showBIOS(a, b : word);

var
    xchar : char;

begin
    xchar := chr(mem[a : b]);
    while (xchar in pchar) and (b > $0000) do begin
        write(xchar);
        inc(b);
        xchar := chr(mem[a : b])
    end;
    writeln
end;

begin (* procedure page_01 *)
    caption2('Machine type');
    with regs do begin
        AH := $C0;
        intr($15, regs);
        if nocarry then begin
            xword1 := memw[ES : BX + 2];
            if (xword1 = $00FC) or (xword1 = $01FC) then
                writeln('PC-AT 3x9')
            else if (xword1 = $00FB) or (xword1 = $01FB) then
                writeln('PC-XT/2')
            else if xword1 = $02FC then
                writeln('PC-XT/286')
            else if xword1 = $00F9 then
                writeln('PC-Convertible')
            else if xword1 = $00FA then
                writeln('PS/2 Model 30')
            else if xword1 = $04FC then
                writeln('PS/2 Model 50')
            else if xword1 = $05FC then
                writeln('PS/2 Model 60')
            else if (xword1 = $04F8) or (xword1 = $09F8) then
                writeln('PS/2 Model 70')
            else if (xword1 = $00F8) or (xword1 = $01F8) then
                writeln('PS/2 Model 80')
            else if xword1 = $06FC then
                writeln('7552 Gearbox')
            else
                unknown('machine - model/type word', xword1, 4);
            caption3('BIOS revision level');
            writeln(mem[ES : BX + 4]);
            xbyte := mem[ES : BX + 5];
            caption3('DMA channel 3 used');
            yesorno2(xbyte and $80 = $80);
            caption3('Slave 8259 present');
            yesorno2(xbyte and $40 = $40);
            caption3('Real-time clock');
            yesorno2(xbyte and $20 = $20);
            caption3('Keyboard intercept available');
            yesorno2(xbyte and $10 = $10);
            caption3('Wait for external event available');
            yesorno2(xbyte and $08 = $08);
            caption3('Extended BIOS data area segment');
            if xbyte and $04 = $04 then begin
                AH := $C1;
                intr($15, regs);
                if nocarry then
                    writeln(hex(ES, 4))
                else
                    dontknow2;
            end else
                writeln('(none)');
            caption3('Micro Channel');
            yesorno2(xbyte and $02 = $02)
        end else begin
            xbyte := mem[$FFFF : $000E];
            case xbyte of
                $FF : writeln('PC');
                $FE : writeln('PC-XT');
                $FD : writeln('PCjr');
                $FC : writeln('PC-AT')
                else
                    unknown('machine - model byte', xbyte, 2)
            end
        end
    end;
(* Byte 12:12 p. 174 *)
    caption2('BIOS source');
    if BIOSscan(PCROMseg, $E000, $FFFF, xword1) then
        showBIOS(PCROMseg, xword1)
    else
        dontknow2;
    caption2('BIOS date');
    i := $0005;
    xbool := true;
    xchar := chr(mem[$FFFF : i]);
    while (i < $0010) and (xchar in pchar) do begin
        xbool := false;
        write(xchar);
        inc(i);
        xchar := chr(mem[$FFFF : i])
    end;
    if xbool then
        dontknow1;
    writeln;
    caption2('BIOS extensions');
    xword1 := BIOScseg;
    xbool := true;
    for i := 0 to 23 do begin
        if (memw[xword1 : 0] = BIOSext) then begin
            if xbool then begin
                writeln;
                window(3, wherey + hi(windmin), twidth, tlength - 2);
                caption1('Segment   Copyright notice');
                writeln;
                xbool := false
            end;
            pause1;
            write(hex(xword1, 4), '      ');
            if BIOSscan(xword1, $0000, $1FFF, xword2) then
                showBIOS(xword1, xword2)
            else
                dontknow2
        end;
        inc(xword1, $0200)
    end;
    if xbool then
        writeln('(none)')
end;

(****************************************************************************)

procedure page_02;

var
    cpu_info : cpu_info_t;

procedure showNDP(a : string; b : word);

begin
    writeln(a);
    caption2('  Infinity');
    case b and $1000 of
        $0000 : writeln('projective');
        $1000 : writeln('affine')
    end;
    caption2('  Rounding');
    case b and $0C00 of
        $0000 : writeln('to nearest or even');
        $0400 : writeln('down');
        $0800 : writeln('up');
        $0C00 : writeln('chop')
    end;
    caption2('  Precision');
    case b and $0300 of
        $0000 : writeln('24 bits');
        $0100 : writeln('(reserved)');
        $0200 : writeln('53 bits');
        $0300 : writeln('64 bits')
    end
end;

begin (* procedure page_02 *)
    caption2('CPU');
    CPUID(cpu_info);
    with cpu_info do begin
        case cpu_type of
            $00 : writeln('8088');
            $01 : writeln('8086');
            $02 : writeln('V20');
            $03 : writeln('V30');
            $04 : writeln('80188');
            $05 : writeln('80186');
            $06 : writeln('80286');
            $07 : writeln('80386')
            else
                unknown('CPU', cpu_type, 2)
        end;
        case cpu_type of
            $06..$07 : begin
                caption3('Machine State Word');
                writeln(hex(MSW, 4));
                caption3('Global Descriptor Table   ');
                for i := 1 to 6 do
                    write(hex(GDT[i], 2), ' ');
                writeln;
                caption3('Interrupt Descriptor Table');
                for i := 1 to 6 do
                    write(hex(IDT[i], 2), ' ');
                writeln
            end
        end;
        case cpu_type of
            07 : begin
                caption3('Operand size (bits)');
                if opsize then
                    writeln('32')
                else
                    writeln('16')
            end
        end;
        caption3('Interrupts enabled correctly after segment register'
            + ' change');
        yesorno2(chkint);
        case cpu_type of
            07 : begin
                caption3('Multiplication correct');
                yesorno2(mult)
            end
        end;
        caption2('Coprocessor');
        case ndp_type of
            $00 : writeln('none');
            $01 : showNDP('8087', ndp_cw);
            $02 : showNDP('80287', ndp_cw);
            $03 : showNDP('80387', ndp_cw)
            else
                dontknow2
        end
    end;
    caption2('Coprocessor enabled');
    yesorno2(equip and $0002 = $0002)
end;

(****************************************************************************)

procedure page_03;

const
    EMMint = $67;
    qEMMdrvr = 'EMMXXXX0';

var
    EMMarray : array[$000..$3FF] of word;
    xlong : longint;
    xword1 : word;
    xword2 : word;
    xstring : string;

procedure EMMerr(a : byte);

begin
    case a of
        $80 : writeln('internal error in EMM software');
        $81 : writeln('malfunction in expanded memory hardware');
        $82 : writeln('memory manager busy');
        $83 : writeln('invalid handle');
        $84 : writeln('undefined function');
        $85 : writeln('no more handles available');
        $86 : writeln('error in save or restore of mapping context');
        $87 : writeln('not enough physical pages available');
        $88 : writeln('not enough free pages available');
        $89 : writeln('no pages requested');
        $8A : writeln('logical page outside range assigned to handle');
        $8B : writeln('invalid physical page number');
        $8C : writeln('page map hardware state save area full');
        $8D : writeln('mapping context already in save area');
        $8E : writeln('mapping context not in save area');
        $8F : writeln('undefined subfunction parameter')
        else
            unknown('expanded memory error', a, 2)
    end
end;

begin (* procedure page_03 *)
    caption2('Total conventional memory (bytes)');
    writeln(DOSmem : 6);
    caption2('Free conventional memory (bytes) ');
    writeln(DOSmem - longint(prefixseg) shl 4 : 6);
    caption2('Extended memory (bytes)        ');
    with regs do begin
        AH := $88;
        intr($15, regs);
        if nocarry then begin
            writeln(longint(AX) shl 10 : 8);
            caption3('XMM installed');
            AX := $4300;
            intr($2F, regs);
            if nocarry and (AL = $80) then begin
                writeln('yes');
                caption3('XMM entry address');
                AX := $4310;
                intr($2F, regs);
                if nocarry then
                    segofs2(ES, BX)
                else
                    dontknow2
            end else
                writeln('no')
(* PC Magazine 8:12 pg. 321 *)
        end else
            writeln('     N/A')
    end;
    caption2('Expanded memory');
    if longint(intvec[EMMint]) <> $00000000 then begin
        writeln;
        caption3('Interrupt vector');
        xlong := longint(intvec[EMMint]);
        xword1 := xlong shr 16;
        xword2 := xlong and $0000FFFF;
        segofs2(xword1, xword2);
        caption3('Driver');
        xstring := '';
        for i := $000A to $0011 do
            xstring := xstring + showchar(chr(mem[xword1 : i]));
        write(xstring);
        if xstring = qEMMdrvr then begin
            writeln;
            caption3('Manager status');
            with regs do begin
                AH := $40;
                intr(EMMint, regs);
                if AH = $00 then
                    writeln('OK')
                else
                    EMMerr(AH);
                caption3('Page frame segment');
                AH := $41;
                intr(EMMint, regs);
                if AH = $00 then
                    writeln(hex(BX, 4))
                else
                    EMMerr(AH);
                caption3('Total EMS memory (16K pages)');
                AH := $42;
                intr(EMMint, regs);
                if AH = $00 then
                    writeln(DX : 3)
                else
                    EMMerr(AH);
                caption3('Free EMS memory (16K pages) ');
                if AH = $00 then
                    writeln(BX : 3)
                else
                    EMMerr(AH);
                caption3('EMM version');
                AH := $46;
                intr(EMMint, regs);
                if AH = $00 then
                    writeln(AL shr 4, chr(country[9]), AL and $0F)
                else
                    EMMerr(AH);
                caption1('  Handle   16K pages');
                writeln;
                AH := $4D;
                ES := seg(EMMarray);
                DI := ofs(EMMarray);
                intr(EMMint, regs);
                if AH = $00 then
                    if BX > $0000 then begin
                        window(3, wherey + hi(windmin), twidth, tlength - 2);
                        for i := 1 to BX do begin
                            pause1;
                            writeln(hex(EMMarray[2 * i - 2], 4), '     '
                                , EMMarray[2 * i - 1] : 3)
                        end
                    end else
                        writeln('  (no active handles)')
                else
                    EMMerr(AH)
            end
        end else
            dontknow2
    end else
        writeln('(none)')
end;

(****************************************************************************)

procedure page_04;

var
    xbyte : byte;
    xword1 : word;
    xword2 : word;
    xword3 : word;
    xword4 : word;

procedure showMCB(MCB, ownerPID, parent, size : word);

var
    i : word;
    xchar : char;
    xlong1 : longint;
    xlong2 : longint;
    xlong3 : longint;
    xstring : string;
    xword : word;

begin
    xlong1 := longint(size) shl 4;
    xword := memw[ownerPID : $002C];
    if ownerPID = $0008 then
        xstring := 'IBMDOS.COM'
    else if ownerPID = parent then
        xstring := 'COMMAND.COM'
(* BIX ms.dos/secrets #1496 *)
(* Software Tools #145, p. 56 *)
    else if (ownerPID = $0000) or (ownerPID = prefixseg) then
        xstring := '(free)'
    else begin
        i := 0;
        while memw[xword : i] > $0000 do
            inc(i);
        inc(i, 4);
        xstring := '';
        xchar := chr(mem[xword : i]);
        while xchar in pchar do begin
            if xchar in dirsep then
                xstring := ''
            else
                xstring := xstring + xchar;
            inc(i);
            xchar := chr(mem[xword : i])
        end;
        if xchar > #0 then
            xstring := ''
    end;
    write(hex(MCB, 4), '   ', hex(ownerPID, 4), '   ', hex(parent, 4), '     '
        , xlong1 : 6, '   ');
    if xword = MCB + 1 then
        write(' ■ ')
    else
        write('   ');
    write('   ', xstring);
    if MCB + 1 = ownerPID then begin
        for i := length(xstring) + 1 to 12 do
            write(' ');
        write('  ');
        xlong2 := longint(ownerPID) shl 4;
        for i := $00 to $FF do begin
            xlong3 := longint(intvec[i]) and $FFFF0000 shr 12
                + longint(intvec[i]) and $0000FFFF;
            if (xlong2 <= xlong3) and (xlong3 <= xlong2 + xlong1) then begin
                if wherex > twidth - 3 then begin
                    writeln;
                    pause1;
                    write('                                                  '
                        , '  ')
                end;
                write(' ', hex(i, 2))
            end
        end
    end;
    writeln
end;

begin (* procedure page_04 *)
    caption1('MCB    PSP    Parent     Size   Env   Owner'
        + '          Interrupts');
    writeln;
    window(1, wherey + hi(windmin), twidth, tlength - 2);
    xword1 := memw[devseg : devofs - $0002];
    repeat
        xbyte := mem[xword1 : $0000];
        xword2 := memw[xword1 : $0001];
        xword3 := memw[xword2 : $0016];
        pause1;
        case xbyte of
            $4D : begin
                xword4 := memw[xword1 : $0003];
                showMCB(xword1, xword2, xword3, xword4);
                inc(xword1, 1 + xword4)
            end;
            $5A : begin
                xword4 := DOSmem shr 4 - xword1 - 1;
                showMCB(xword1, xword2, xword3, xword4)
            end else
                unknown('MCB status', xbyte, 2)
        end
    until xbyte <> $4D
(* PC Magazine 6:14 p.425 *)
end;

(****************************************************************************)

procedure page_05;

var
    i : byte;
    xbyte : byte;
    xint1 : integer;
    xint2 : integer;
    xword : word;

procedure showdisp(a : string; b : byte);

begin
    caption2(a);
    case b of
        $00 : writeln('(none)');
        $01 : writeln('MDA + 5151');
        $02 : writeln('CGA + 5153/5154');
        $03 : writeln('(reserved)');
        $04 : writeln('EGA + 5153/5154');
        $05 : writeln('EGA 5151');
        $06 : writeln('PGA + 5175');
        $07 : writeln('VGA + analog monochrome');
        $08 : writeln('VGA + analog color');
        $09 : writeln('(reserved)');
        $0A : writeln('MCGA + digital color');
        $0B : writeln('MCGA + digital monochrome');
        $0C : writeln('MCGA + analog color');
        $0D..$FE : writeln('(reserved)');
        $FF : dontknow2
    end
end;

procedure showcolor(a : byte);

begin
    case a of
        black            : write('black');
        blue            : write('blue');
        green            : write('green');
        cyan            : write('cyan');
        red                : write('red');
        magenta            : write('magenta');
        brown            : write('brown');
        lightgray        : write('light gray');
        darkgray        : write('dark gray');
        lightblue        : write('light blue');
        lightgreen        : write('light green');
        lightcyan        : write('light cyan');
        lightred        : write('light red');
        lightmagenta    : write('light magenta');
        yellow            : write('yellow');
        white            : write('white')
        else
            unknown('color', a, 2)
    end
end;

begin (* procedure page_05 *)
    with regs do begin
        AX := $1A00;
        intr($10, regs);
        if AL = $1A then begin
            showdisp('Active video subsystem  ', BL);
            showdisp('Inactive video subsystem', BH)
        end
    end;
    caption2('Initial video mode');
    case equip and $0030 of
        $0000 : writeln('No display');
        $0010 : writeln('40 x 25 color');
        $0020 : writeln('80 x 25 color');
        $0030 : writeln('80 x 25 monochrome')
    end;
    caption2('Current video mode');
    xbyte := lo(lastmode);
    write(xbyte, ' ');
    case xbyte of
        $00 : writeln('(40 x 25 b/w text)');
        $01 : writeln('(40 x 25 color text)');
        $02 : writeln('(80 x 25 b/w text)');
        $03 : writeln('(80 x 25 color text)');
        $04 : writeln('(320 x 200 4 colors)');
        $05 : writeln('(320 x 200 4 colors, no color burst)');
        $06 : writeln('(640 x 200 2 colors)');
        $07 : writeln('(MDA text)');
        $08 : writeln('(160 x 200 16 colors)');
        $09 : writeln('(320 x 200 16 colors)');
        $0A : writeln('(640 x 200 4 colors)');
        $0D : writeln('(320 x 200 16 colors)');
        $0E : writeln('(640 x 200 16 colors)');
        $0F : writeln('(640 x 350 monochrome)');
        $10 : writeln('(640 x 350 16 colors)');
        $11 : writeln('(640 x 480 2 colors)');
        $12 : writeln('(640 x 480 16 colors)');
        $13 : writeln('(640 x 480 256 colors)')
        else
            unknown('video mode', xbyte, 2)
    end;
    caption2('Current display page');
    writeln(vidpg);
    caption2('Graphics modes');
    getmoderange(graphdriver, xint1, xint2);
    if graphresult = grok then
        writeln(xint2 + 1 - xint1)
    else
        writeln(0);
    caption2('Video buffer (offset)');
    writeln(hex(memw[BIOSdseg : $004E], 4));
    caption2('Video buffer size (bytes)');
    writeln(memw[BIOSdseg : $004C]);
    caption2('Active display port');
    xword := memw[BIOSdseg : $0063];
    write('$', hex(xword, 3), ' ');
    if xword = $03B4 then
        writeln('(monochrome)')
    else if xword = $03D4 then
        writeln('(color)')
    else
        dontknow2;
    caption2('CRT mode register');
    writeln('$', hex(mem[BIOSdseg : $0065], 2));
    caption2('Current palette');
    writeln('$', hex(mem[BIOSdseg : $0066], 2));
    caption2('Colors');
    caption1('·');
    for i := black to white do begin
        textcolor(i);
        write('█')
    end;
    caption1('·');
    writeln;
    caption2('Current colors');
    if (attrsave and $80) = $80 then
        write('blinking ');
    showcolor(attrsave and $0F);
    write(' on ');
    showcolor(attrsave and $70 shr 4);
    writeln;
    caption2('Text rows');
    writeln(tlength);
    caption2('Text columns');
    writeln(twidth);
    if graphdriver in [EGA, MCGA, VGA] then begin
        caption2('Scan lines/character');
        with regs do begin
            AX := $1130;
            BH := $00;
            intr($10, regs);
            writeln(CX)
        end
    end;
    caption2('Cursor scan lines');
    with regs do begin
        AH := $03;
        BH := vidpg;
        intr($10, regs);
        writeln(CH, '-', CL)
    end
end;

(****************************************************************************)

procedure page_06;

var
    i : byte;
    VGAbuf : array[$00..$10] of byte;
    xbyte : byte;
    xword1 : word;
    xword2 : word;
    xword3 : word;
    xword4 : word;

procedure captfont;

begin
    caption1('Font           Address');
    writeln;
    write('INT 1FH        ');
    segofs2(longint(intvec[$1F]) shr 16, longint(intvec[$1F]) and $0000FFFF)
end;

procedure showfont(a : byte);

begin
    with regs do begin
        case a of
            $00 : write('INT 1FH     ');
            $01 : write('INT 43H     ');
            $02 : write('ROM 8x14    ');
            $03 : write('ROM 8x8 (lo)');
            $04 : write('ROM 8x8 (hi)');
            $05 : write('ROM 9x14    ');
            $06 : write('ROM 8x16    ');
            $07 : write('ROM 9x16    ')
        end;
        write('   ');
        AX := $1130;
        BH := a;
        intr($10, regs);
        segofs2(ES, BP)
    end
end;

procedure int101210;

begin
    with regs do begin
        AH := $12;
        BL := $10;
        intr($10, regs);
        caption2('Display type');
        case BH of
            $00 : writeln('color');
            $01 : writeln('monochrome')
            else
                unknown('display', BH, 2)
        end;
        caption2('Memory');
        case BL of
            $00 : writeln('64K');
            $01 : writeln('128K');
            $02 : writeln('192K');
            $03 : writeln('256K')
            else
                unknown('size', BL, 2)
        end;
        caption2('Feature bits');
        writeln(bin4(CH and $0F));
        caption2('DIP switches');
        writeln(bin4(CL and $0F))
    end
end;

begin (* procedure page_06 *)
    caption2('Display adapter');
    case graphdriver of
        CGA : begin
            writeln('CGA');
            captfont
        end;
        MCGA : begin
            writeln('MCGA');
            captfont;
            showfont($01);
            showfont($03);
            showfont($04);
            showfont($06)
        end;
        EGA..EGAmono : begin
            writeln('EGA');
            captfont;
            showfont($01);
            showfont($02);
            showfont($03);
            showfont($04);
            showfont($05);
            int101210;
            xbyte := mem[BIOSdseg : $0087];
            caption2('Mode change preserves screen buffer');
            yesorno2(xbyte and $80 = $80);
            caption2('EGA active');
            yesorno2(xbyte and $08 = $00);
            caption2('Wait for display enable');
            yesorno2(xbyte and $04 = $04);
            caption2('CGA cursor emulation');
            yesorno2(xbyte and $01 = $00);
(* PC Magazine 6:12 p.326 *)
            caption2('Save area                    ');
            xword1 := memw[BIOSdseg : $00AA];
            xword2 := memw[BIOSdseg : $00A8];
            segofs2(xword1, xword2);
(* PC Tech Journal 3:4 p.65 *)
            caption2('Video parameter table        ');
            segofs2(memw[xword1 : xword2 + 2], memw[xword1 : xword2]);
            caption2('Dynamic save area            ');
            xword3 := memw[xword1 : xword2 + 6];
            xword4 := memw[xword1 : xword2 + 4];
            if (xword3 > $0000) or (xword4 > $0000) then
                segofs2(xword3, xword4)
            else
                writeln('(none)');
            caption2('Auxiliary character generator');
            xword3 := memw[xword1 : xword2 + 10];
            xword4 := memw[xword1 : xword2 + 8];
            if (xword3 > $0000) or (xword4 > $0000) then
                segofs2(xword3, xword4)
            else
                writeln('(none)');
            caption2('Graphics mode auxiliary table');
            xword3 := memw[xword1 : xword2 + 14];
            xword4 := memw[xword1 : xword2 + 12];
            if (xword3 > $0000) or (xword4 > $0000) then
                segofs1(xword3, xword4)
            else
                write('(none)')
(* PC Tech Journal 3:4 p.67 *)
        end;
        hercmono : begin
            writeln('Hercules or MDA');
            captfont
        end;
        IBM8514 : begin
            writeln('IBM 8514');
            captfont
        end;
        ATT400 : begin
            writeln('AT&T 400');
            captfont
        end;
        VGA : begin
            writeln('VGA');
            captfont;
            showfont($01);
            showfont($02);
            showfont($03);
            showfont($04);
            showfont($05);
            showfont($06);
            showfont($07);
            int101210;
            with regs do begin
                AX := $1009;
                ES := seg(VGAbuf);
                DX := ofs(VGAbuf);
                intr($10, regs)
            end;
            caption2('Palette registers');
            for i := $00 to $0F do
                write(hex(VGAbuf[i], 2), ' ');
            writeln;
            caption2('Border color');
            writeln(hex(VGAbuf[$10], 2));
            caption2('Color page');
            with regs do begin
                AX := $101A;
                intr($10, regs);
                writeln('$', hex(BH, 2));
                caption2('Paging mode');
                case BL of
                    $00 : writeln('4 pages of 64 registers');
                    $01 : writeln('16 pages of 16 registers')
                    else
                        unknown('mode', BL, 2)
                end
            end
        end;
        PC3270 : begin
            writeln('3270 PC');
            captfont
        end else
            unknown('adapter', graphdriver, 4)
    end
end;

(****************************************************************************)

procedure page_07;

const
    mouseint = $33;

var
    xbyte : byte;
    xword1 : word;
    xword2 : word;

begin
    caption2('Keyboard');
    writeln;
    caption3('BIOS support for enhanced keyboard');
    with regs do begin
        AH := $02;
        intr($16, regs);
        xbyte := AL;
        AX := $1200 + xbyte xor $FF;
        intr($16, regs);
        if AL = xbyte then begin
            writeln('yes');
            caption3('Enhanced keyboard present');
            yesorno2(mem[BIOSdseg : $0096] and $10 = $10)
        end else
            writeln('no');
(* PC Magazine 6:15 p.378 *)
        AH := $02;
        intr($16, regs);
        caption3('Insert');
        offoron(AL and $80 = $80);
        caption1('   Caps Lock: ');
        offoron(AL and $40 = $40);
        caption1('   Num Lock: ');
        offoron(AL and $20 = $20);
        caption1('   Scroll Lock: ');
        offoron(AL and $10 = $10);
        writeln
    end;
    caption3('Buffer');
    xword1 := memw[BIOSdseg : $0080];
    segofs1(BIOSdseg, xword1);
    xword2 := memw[BIOSdseg : $0082];
    writeln('-', hex(xword2, 4));
    caption3('Buffer size (keystrokes)');
    writeln((xword2 - xword1) shr 1 - 1);
    caption2('Internal modem/serial printer');
    yesorno2(equip and $2000 = $2000);
    caption2('Game port');
    yesorno2(equip and $1000 = $1000);
    caption2('Mouse');
    with regs do begin
        AX := $0000;
        intr(mouseint, regs);
        if AX = $FFFF then begin
            writeln('yes');
            caption3('Buttons');
            writeln(BX);
            caption3('Save state buffer size (bytes)');
            AX := $0015;
            BX := $FFFF;
            intr(mouseint, regs);
            if BX < $FFFF then
                writeln(BX)
            else
                dontknow2;
            caption3('Mickeys/pixel (horizontal)');
            AX := $001B;
            BX := $FFFF;
            CX := $FFFF;
            DX := $FFFF;
            intr(mouseint, regs);
            if BX < $FFFF then
                writeln(BX : 5)
            else
                dontknow2;
            caption3('Mickeys/pixel (vertical)  ');
            if CX < $FFFF then
                writeln(CX : 5)
            else
                dontknow2;
            caption3('Double speed threshold');
            if DX < $FFFF then
                writeln(DX)
            else
                dontknow2;
            caption3('Current display page');
            AX := $001E;
            BX := $FFFF;
            intr(mouseint, regs);
            if BX < $FFFF then
                writeln(BX)
            else
                dontknow2;
            caption3('Language');
            AX := $0023;
            BX := $FFFF;
            intr(mouseint, regs);
            if BX < $FFFF then
                if BX = $0000 then
                    writeln('English')
                else if BX = $0001 then
                    writeln('French')
                else if BX = $0002 then
                    writeln('Dutch')
                else if BX = $0003 then
                    writeln('German')
                else if BX = $0004 then
                    writeln('Swedish')
                else if BX = $0005 then
                    writeln('Finnish')
                else if BX = $0006 then
                    writeln('Spanish')
                else if BX = $0007 then
                    writeln('Portuguese')
                else if BX = $0008 then
                    writeln('Italian')
                else
                    unknown('language', BX, 4)
            else
                dontknow2;
            caption3('Driver version');
            AX := $0024;
            BX := $FFFF;
            CX := $FFFF;
            intr(mouseint, regs);
            if BX < $FFFF then begin
                write(BH, chr(country[9]));
                zeropad(BL)
            end else
                dontknow1;
            writeln;
            caption3('Type');
            if CX < $FFFF then
                case CH of
                    $01 : writeln('bus');
                    $02 : writeln('serial');
                    $03 : writeln('InPort');
                    $04 : writeln('PS/2');
                    $05 : writeln('HP')
                    else
                        unknown('mouse', CH, 2)
                end
            else
                dontknow2;
            caption3('Interrupt');
            if CX < $FFFF then
                case CL of
                    $00 : writeln('PS/2');
                    $02..$05, $07 : writeln('IRQ', CL)
                    else
                        unknown('interrupt', CL, 2)
                end
            else
                dontknow2
        end else
            writeln('no')
    end
end;

(****************************************************************************)

procedure page_08;

const
    tick2 = 115200;

var
    i : byte;
    xbyte1 : byte;
    xbyte2 : byte;
    xword : word;
    y : byte;


begin
    y := wherey + hi(windmin);
    window(1, y, 30, tlength - 2);
    caption2('Printers');
    xbyte1 := equip and $C000 shr 14;
    writeln(xbyte1);
    if xbyte1 > 0 then begin
        caption3('Device');
        writeln;
        caption3('Base port');
        writeln;
        caption3('Timeout');
        writeln;
        caption3('Busy');
        writeln;
        caption3('ACK');
        writeln;
        caption3('Paper out');
        writeln;
        caption3('Selected');
        writeln;
        caption3('I/O error');
        writeln;
        caption3('Timed out');
        for i := 1 to xbyte1 do begin
            window(9 + 6 * i, y + 1, 15 + 6 * i, tlength - 2);
            writeln('LPT', i);
            writeln('$', hex(memw[BIOSdseg : 2 * i + 6], 3));
            writeln(mem[BIOSdseg : $0077 + i]);
            with regs do begin
                AH := $02;
                DX := 0;
                intr($17, regs);
                yesorno2(AH and $80 = $00);
                yesorno2(AH and $40 = $40);
                yesorno2(AH and $20 = $20);
                yesorno2(AH and $10 = $10);
                yesorno2(AH and $08 = $08);
                yesorno2(AH and $01 = $01)
            end
        end
    end;
    window(twidth - 42, y, twidth, tlength - 2);
    caption2('Serial ports');
    xbyte1 := equip and $0E00 shr 9;
    writeln(xbyte1);
    if xbyte1 > 0 then begin
        if xbyte1 > 4 then
            xbyte1 := 4;
        caption3('Device');
        writeln;
        caption3('Base port');
        writeln;
        caption3('Timeout');
        writeln;
        caption3('Baud rate');
        writeln;
        caption3('Data bits');
        writeln;
        caption3('Parity');
        writeln;
        caption3('Stop bits');
        writeln;
        caption3('Break');
        writeln;
        caption3('RLSD');
        writeln;
        caption3('RI');
        writeln;
        caption3('DSR');
        writeln;
        caption3('CTS');
        writeln;
        caption3('dRLSD');
        writeln;
        caption3('-dRI');
        writeln;
        caption3('dDSR');
        writeln;
        caption3('dCTS');
        for i := 1 to xbyte1 do begin
            window(twidth - 35 + 7 * i, y + 1, twidth - 28 + 7 * i
                , tlength - 2);
            writeln('COM', i);
            xword := memw[BIOSdseg : 2 * i - 2];
            writeln('$', hex(xword, 3));
            writeln(mem[BIOSdseg : $007B + i]);
            xbyte2 := port[xword + 3];
            port[xword + 3] := xbyte2 or $80;
            writeln(tick2 / cbw(port[xword], port[xword + 1]) : 0 : 0);
            port[xword + 3] := xbyte2;
            case xbyte2 and $03 of
                $00 : writeln('5');
                $01 : writeln('6');
                $02 : writeln('7');
                $03 : writeln('8')
            end;
            case xbyte2 and $38 of
                $00, $10, $20, $30 : writeln('none');
                $08 : writeln('odd');
                $18 : writeln('even');
                $28 : writeln('mark');
                $38 : writeln('space')
            end;
            case xbyte2 and $07 of
                $00..$03 : writeln('1');
                $04 : writeln('1.5');
                $05..$07 : writeln('2')
            end;
            yesorno2(xbyte2 and $40 = $40);
            with regs do begin
                AH := $03;
                DX := i - 1;
                intr($14, regs);
                yesorno2(AL and $80 = $80);
                yesorno2(AL and $40 = $40);
                yesorno2(AL and $20 = $20);
                yesorno2(AL and $10 = $10);
                yesorno2(AL and $08 = $08);
                yesorno2(AL and $04 = $04);
                yesorno2(AL and $02 = $02);
                yesorno2(AL and $01 = $01)
            end
        end
    end
end;

(****************************************************************************)

procedure page_09;

const
    filesmax = 256;

var
    f : array[1..filesmax] of file;
    i : 0..filesmax;
    j : 1..filesmax;
    xbool : boolean;
    xbyte : byte;
    xchar : char;
    xstring1 : string;
    xstring2 : string;
    xword1 : word;
    xword2 : word;
    xword3 : word;
    xword4 : word;
    xword5 : word;
    y : byte;

procedure showecho(a : word);

var
    xbyte : byte;

begin
    xbyte := mem[DOScseg : a];
    case xbyte of
        $00 : writeln('off');
        $FF : writeln('on')
        else
            unknown('status', xbyte, 2)
    end
end;

begin (* procedure page_09 *)
    y := wherey + hi(windmin);
    window(1, y, twidth div 2, tlength - 2);
    caption2('DOS version');
    with regs do begin
        AH := $30;
        MSDOS(regs);
        write(AL, chr(country[9]));
        zeropad(AH);
        writeln;
        caption2('OEM serial # ');
        writeln(BH);
        caption2('User serial #');
        writeln(longint(BL) shl 16 + CX)
    end;
    caption2('System date');
    getdate(xword1, xword2, xword3, xword4);
    if xword4 = 0 then
        write('Sunday')
    else if xword4 = 1 then
        write('Monday')
    else if xword4 = 2 then
        write('Tuesday')
    else if xword4 = 3 then
        write('Wednesday')
    else if xword4 = 4 then
        write('Thursday')
    else if xword4 = 5 then
        write('Friday')
    else if xword4 = 6 then
        write('Saturday')
    else
        write('(', hex(xword4, 4), ')');
    write(', ');
    xword5 := cbw(country[0], country[1]);
    xchar := chr(country[11]);
    if xword5 = $0000 then
        writeln(xword2, xchar, xword3, xchar, xword1)
    else if xword5 = $0001 then
        writeln(xword3, xchar, xword2, xchar, xword1)
    else if xword5 = $0002 then
        writeln(xword1, xchar, xword2, xchar, xword3)
    else
        writeln(xword2, xchar, xword3, xchar, xword1);
    caption2('System time');
    gettime(xword1, xword2, xword3, xword4);
    zeropad(xword1);
    write(chr(country[13]));
    zeropad(xword2);
    write(chr(country[13]));
    zeropad(xword3);
    write(chr(country[9]));
    zeropad(xword4);
    writeln;
    caption2('Command load paragraph');
    writeln(hex(prefixseg, 4));
    caption2('Ctrl-C check');
    getcbreak(xbool);
    offoron(xbool);
    writeln;
    caption2('Disk verify');
    getverify(xbool);
    offoron(xbool);
    writeln;
    caption2('Switch prefix character');
    writeln(switchar);
    caption2('\DEV\ prefix for devices');
    with regs do begin
        AX := $3702;
        MSDOS(regs);
        if DL = $00 then
            writeln('required')
        else
            writeln('optional')
    end;
    caption2('Reset boot');
    xword1 := memw[BIOSdseg : $72];
    if xword1 = $0000 then
        writeln('cold')
    else if (xword1 = $1234) or (xword1 = $1200) then
        writeln('bypass memory test')
    else if xword1 = $4321 then
        writeln('preserve memory')
    else if xword1 = $5678 then
        writeln('system suspended')
    else if xword1 = $9ABC then
        writeln('manufacturing test mode')
    else if xword1 = $ABCD then
        writeln('system POST loop mode')
    else
        unknown('flag', xword1, 4);
(* Byte 12:12 p.178 *)
    with regs do begin
        caption2('DOS critical flag');
        AX := $5D06;
        MSDOS(regs);
        segofs2(DS, SI)
    end;
    caption2('DOS busy flag    ');
    segofs2(DOScseg, DOScofs);
    caption2('Printer echo');
    case osminor of
        0..9 : dontknow2;
        10..39 : showecho($02AC)
        else
            dontknow2
    end;
(* BIX ms.dos/secrets #501 *)
    caption2('PrtSc status');
    xbyte := mem[BIOSdseg : $0100];
    case xbyte of
        $00 : writeln('ready');
        $01 : writeln('busy');
        $FF : writeln('error on last PrtSc')
        else
            unknown('status', xbyte, 2)
    end;
    caption2('Memory allocation');
    with regs do begin
        AX := $5800;
        MSDOS(regs);
        if AX = $0000 then
            writeln('first fit')
        else if AX = $0001 then
            writeln('best fit')
        else
            writeln('last fit')
    end;
    window(1 + twidth div 2, y, twidth, tlength - 2);
    caption2('DOS buffers');
    xword1 := 0;
    xword2 := memw[devseg : devofs + $0014];
    xword3 := memw[devseg : devofs + $0012];
    while (xword2 < $FFFF) or (xword3 < $FFFF) do begin
        inc(xword1);
        xword4 := memw[xword2 : xword3 + $0002];
        xword3 := memw[xword2 : xword3];
        xword2 := xword4
    end;
    writeln(xword1);
    caption2('Buffer size (bytes)');
    writeln(memw[devseg : devofs + $0010]);
(* BIX ms.dos/long.messages #228 *)
    caption2('File handle table');
    xword1 := memw[prefixseg : $0036];
    xword2 := memw[prefixseg : $0034];
    segofs2(xword1, xword2);
    caption2('File handle table length');
    writeln(mem[prefixseg : $0032] : 3);
    caption2('File handles used       ');
    i := 0;
    while mem[xword1 : xword2] < $FF do begin
        inc(i);
        inc(xword2)
    end;
    writeln(i : 3);
    caption1('File handles free');
    i := 0;
    xbool := false;
    xstring1 := getenv('comspec');
    repeat
        if i < filesmax then begin
            assign(f[i + 1], xstring1);
            reset(f[i + 1]);
            if ioresult = 0 then
                inc(i)
            else begin
                xbool := true;
                caption2('       ');
                writeln(i : 3)
            end
        end else begin
            xbool := true;
            caption2('');
            dontknow2
        end
    until xbool;
    for j := 1 to i do
        close(f[j]);
    caption2('Global code page');
    with regs do begin
        AX := $6601;
        MSDOS(regs);
        if AL = $01 then begin
            writeln;
            caption3('Active ');
            writeln(BX : 5);
            caption3('Default');
            writeln(DX : 5)
        end else
            writeln('N/A')
    end;
    caption2('Country code');
    writeln(ccode);
    caption2('Thousands separator character');
    writeln(chr(country[7]));
    caption2('Decimal separator character');
    writeln(chr(country[9]));
    caption2('Data-list separator character');
    writeln(chr(country[22]));
    caption2('Date format');
    xword1 := cbw(country[0], country[1]);
    xchar := chr(country[11]);
    if xword1 = $0000 then
        writeln('USA (mm', xchar, 'dd', xchar, 'yy)')
    else if xword1 = $0001 then
        writeln('Europe (dd', xchar, 'mm', xchar, 'yy)')
    else if xword1 = $0002 then
        writeln('Japan (yy', xchar, 'mm', xchar, 'dd)')
    else
        unknown('format', xword1, 4);
    caption3('Separator character');
    writeln(xchar);
    caption2('Time format');
    if (country[17] and $01) = $00 then
        write('12')
    else
        write('24');
    writeln('-hour');
    caption3('Separator character');
    writeln(chr(country[13]));
    caption2('Currency format');
    xstring1 := 'xxxx';
    insert(chr(country[7]), xstring1, 2);
    xstring1 := xstring1 + chr(country[9]);
    for i := 1 to country[16] do
        xstring1 := xstring1 + 'y';
    xstring2 := '';
    i := 2;
    xchar := chr(country[i]);
    while (i <= 6) and (xchar > #0) do begin
        xstring2 := xstring2 + xchar;
        inc(i);
        xchar := chr(country[i])
    end;
    case country[15] and $03 of
        $00 : xstring1 := xstring2 + xstring1;
        $01 : xstring1 := xstring1 + xstring2;
        $02 : xstring1 := xstring2 + ' ' + xstring1;
        $03 : xstring1 := xstring1 + ' ' + xstring2;
        $04 : begin
            delete(xstring1, 6, 1);
            insert(xstring2, xstring1, 6)
        end
    end;
    writeln(xstring1);
    caption2('Case map call address');
    segofs2(cbw(country[20], country[21]), cbw(country[18], country[19]))
end;

(****************************************************************************)

procedure page_10;

var
    i : word;
    xchar : char;

procedure muxint(a : string; b : byte);

begin
    caption3(a);
    with regs do begin
        AX := b shl 8;
        intr($2F, regs);
        if nocarry then
            case AL of
                $00 : writeln('no, OK to install');
                $01 : writeln('no, not OK to install');
                $FF : writeln('yes')
                else
                    unknown('status', AL, 2)
            end
        else
            writeln('N/A')
    end
end;

begin (* procedure page_10 *)
    caption2('Multiplex interrupt ($2F)');
    writeln;
    muxint('PRINT          ', $01);
    muxint('ASSIGN         ', $06);
(*
**    Byte 12:12 p. 176C, Duncan, and many others, all of whom mistakenly give
**    AH = $02
*)
(*
    muxint('DRIVER.SYS     ', $08);
*)
    muxint('SHARE          ', $10);
(*
    muxint('FASTOPEN       ', $12);
*)
    muxint('NLSFUNC        ', $14);
    muxint('GRAFTABL       ', $B0);
(*
    muxint('DISPLAY.SYS    ', $B0);
*)
    muxint('APPEND         ', $B7);
(*
    muxint('KEYB           ', $B8);
*)
    muxint('NETBIOS APPEND ', $87);
    muxint('NETBIOS NETWORK', $88);
(* Byte 12:12 p. 180.  PC Tech Journal 3:11 p.104 gives AH = $BB *)
    with regs do begin
        AX := $B700;
        intr($2F, regs);
        if AL = $FF then begin
            caption2('APPEND');
            writeln;
            caption3('Path');
            AX := $B704;
            intr($2F, regs);
            if nocarry then begin
                xchar := chr(mem[ES : DI]);
                while xchar > #0 do begin
                    write(xchar);
                    inc(DI);
                    xchar := chr(mem[ES : DI])
                end;
                writeln
            end else
                dontknow2;
        end
    end;
    with regs do begin
        AX := $0100;
        intr($2F, regs);
        if AL = $FF then begin
            caption2('PRINT queue');
            AX := $0104;
            intr($2F, regs);
            xchar := chr(mem[DS : SI]);
            if xchar > #0 then begin
                writeln;
                window(3, wherey + hi(windmin), twidth, tlength - 2);
                repeat
                    pause1;
                    i := SI;
                    xchar := chr(mem[DS : i]);
                    repeat
                        write(xchar);
                        inc(i);
                        xchar := chr(mem[DS : i])
                    until xchar = #0;
                    writeln;
                    inc(SI, 64);
                    xchar := chr(mem[DS : SI])
                until xchar = #0
            end else
                writeln('(empty)');
            AX := $0105;
            intr($2F, regs)
        end
    end
end;

(****************************************************************************)

procedure page_11;

begin
    caption2('Environment');
    window(3, wherey + hi(windmin) + 1, twidth, tlength - 2);
    for i := 1 to envcount do begin
        pause1;
        writeln(envstr(i))
    end
end;

(****************************************************************************)

procedure page_12;

const
    headermin = 0;
    headermax = 17;
    nuldev : string = 'NUL        ';

var
    FCB : array[$00..$24] of byte;
    header : array[headermin..headermax] of byte;
    i : byte;
    xword1 : word;
    xword2 : word;

begin
    caption1('Device      Units    Header       Attributes'
        + '             Strategy     Interrupt');
    writeln;
    window(1, wherey + hi(windmin), twidth, tlength - 2);
    case osminor of
        0..9 : begin
            fillchar(FCB, sizeof(FCB), 0);
            for i := 1 to 11 do
                FCB[i] := ord(nuldev[i]);
            with regs do begin
                AH := $0F;
                DS := seg(FCB);
                DX := ofs(FCB);
                MSDOS(regs)
            end;
            xword1 := cbw(FCB[$1C], FCB[$1D]);
            xword2 := cbw(FCB[$1A], FCB[$1B])
        end;
        10..39 : begin
            xword1 := devseg;
            xword2 := devofs + $0022
        end
    end;
    while xword2 < $FFFF do begin
        pause1;
        for i := headermin to headermax do
            header[i] := mem[xword1 : xword2 + i];
        if header[5] and $80 = $00 then
            write('            ', header[10] : 5)
        else begin
            for i := 10 to headermax do
                write(showchar(chr(header[i])));
            write('         ')
        end;
        write('    ');
        segofs1(xword1, xword2);
        write('    ', bin16(cbw(header[4], header[5])), '    ');
        segofs1(xword1, cbw(header[6], header[7]));
        write('    ');
        segofs2(xword1, cbw(header[8], header[9]));
        xword1 := cbw(header[2], header[3]);
        xword2 := cbw(header[0], header[1])
    end
end;

(****************************************************************************)

procedure page_13;

var
    i : $00..$2B;
    xbyte : byte;
    xchar : 'A'..'Z';
    xFCB : array[$00..$2B] of byte;
    xlong : longint;
    xstring : string;
    xword1 : word;
    xword2 : word;
    y : byte;

begin
    y := wherey + hi(windmin);
    window(1, y, twidth div 2, tlength - 2);
    if osminor >= 10 then begin
        caption2('LASTDRIVE');
        drvname(mem[devseg : devofs + $0021] - 1);
        writeln
    end;
    caption2('Diskette drives');
    if equip and $0001 = $0001 then
        writeln(1 + equip and $00C0 shr 6)
    else
        writeln(0);
    xword1 := longint(intvec[$1E]) shr 16;
    xword2 := longint(intvec[$1E]) and $0000FFFF;
    caption3('Sectors/track');
    writeln(mem[xword1 : xword2 + 4]);
    caption3('Bytes/sector');
    writeln(mem[xword1 : xword2 + 3] shl 8);
    caption3('On time (ms)');
    writeln(125 * mem[xword1 : xword2 + 10]);
    caption3('Off time (s)');
    writeln(longint(mem[xword1 : xword2 + 2]) shl 16 / tick1 : 0 : 1);
    caption3('Head settle time (ms)');
    writeln(mem[xword1 : xword2 + 9]);
    caption1('  Single drive is now ');
    xbyte := mem[BIOSdseg : $0104];
    if xbyte <= ord('Z') - ord('A') then begin
        drvname(xbyte);
        writeln
    end else if xbyte = $FF then
        writeln('N/A')
    else
        unknown('status', xbyte, 2);
(* Byte 12:12 p.178 *)
    writeln;
    caption1('Drive   Removable');
    if osminor >= 10 then begin
        caption1('   Remote');
        if osminor >= 20 then
            caption1('   Alias')
    end;
    writeln;
    window(wherex + lo(windmin), wherey + hi(windmin), twidth, tlength - 2);
    with regs do begin
        for xchar := 'A' to 'Z' do begin
            AH := $0E;
            DL := ord(xchar) - ord('A');
            MSDOS(regs);
            AH := $19;
            MSDOS(regs);
            if AL = DL then begin
                pause1;
                drvname(AL);
                write('     ');
                AX := $4408;
                BL := 0;
                MSDOS(regs);
                if nocarry then
                    yesorno1(AL = $00)
                else
                    write('?  ');
                if osminor >= 10 then begin
                    write('         ');
                    AX := $4409;
                    BL := 0;
                    MSDOS(regs);
                    if nocarry then
                        yesorno1(DH and $10 = $10)
                    else
                        write('?  ');
                    if osminor >= 20 then begin
                        write('      ');
                        AX := $440E;
                        BL := 0;
                        MSDOS(regs);
                        if nocarry then
                            if AL = $00 then
                                write('(none)')
                            else
                                drvname(AL - 1)
                        else
                            write('?')
                    end
                end;
                writeln
            end
        end;
        AH := $0E;
        DL := currdrv;
        MSDOS(regs)
    end;
    window(1 + twidth div 2, y, twidth, tlength - 2);
    caption2('Current drive and path');
    getdir(0, xstring);
    writeln(xstring);
    caption3('Volume label');
    for i := $00 to $2B do
        xFCB[i] := $00;
    xFCB[$00] := $FF;                    (* extended FCB *)
    xFCB[$06] := $08;                    (* volume ID attribute *)
    for i := $08 to $12 do
        xFCB[i] := ord('?');
    with regs do begin
        AH := $11;
        DS := seg(xFCB);
        DX := ofs(xFCB);
        MSDOS(regs);
        case AL of
            $00 : begin
                AH := $2F;
                MSDOS(regs);
                i := $08;
                xchar := char(mem[ES : BX + i]);
                while (i <= $12) and (xchar > #0) do begin
                    write(showchar(xchar));
                    inc(i);
                    xchar := char(mem[ES : BX + i])
                end;
                writeln
            end;
            $FF : writeln('(none)')
            else
                unknown('status', AL, 2)
        end;
        AH := $1B;
        MSDOS(regs);
        media(mem[DS : BX]);
        caption3('Clusters');
        writeln(DX);
        caption3('Sectors/cluster');
        writeln(AL);
        caption3('Bytes/sector');
        writeln(CX)
    end;
    caption3('Total space (bytes)');
    xlong := disksize(0);
    if xlong <> -1 then
        writeln(xlong : 8)
    else
        dontknow2;
    caption3('Free space (bytes) ');
    xlong := diskfree(0);
    if xlong <> -1 then
        writeln(xlong : 8)
    else
        dontknow2
end;

(****************************************************************************)

procedure page_14;

var
    i : byte;
    xbool : boolean;
    xbyte1 : byte;
    xbyte2 : byte;
    y : byte;

begin
    caption2('BIOS disk parameters');
    xbool := true;
    for i := $00 to $FF do
        with regs do begin
            AH := $08;
            DL := i;
            intr($13, regs);
            if nocarry and ((BL > $00) or (i >= $80)) then
                begin
                if xbool then begin
                    xbool := false;
                    writeln;
                    y := wherey + hi(windmin);
                    caption3('Unit');
                    writeln;
                    caption3('Type');
                    writeln;
                    caption3('Drives');
                    writeln;
                    caption3('Heads');
                    writeln;
                    caption3('Cylinders');
                    writeln;
                    caption3('Sectors/track');
                    writeln;
                    caption3('Specify bytes');
                    writeln;
                    caption3('Off time (s)');
                    writeln;
                    caption3('Bytes/sector');
                    writeln;
                    caption3('Sectors/track');
                    writeln;
                    caption3('Gap length');
                    writeln;
                    caption3('Data length');
                    writeln;
                    caption3('Gap length for format');
                    writeln;
                    caption3('Fill byte for format');
                    writeln;
                    caption3('Head settle time (ms)');
                    writeln;
                    caption3('On time (ms)');
                    writeln;
                    xbyte1 := 27
                end;
                if xbyte1 + 10 > twidth then begin
                    pause2;
                    xbyte1 := 27;
                    window(xbyte1, y, twidth, tlength - 2);
                    clrscr
                end;
                window(xbyte1, y, xbyte1 + 11, tlength - 2);
                writeln(i);
                if i < $80 then
                    case BL of
                        $01 : writeln('360KB 5¼"');
                        $02 : writeln('1.2MB 5¼"');
                        $03 : writeln('720KB 3½"');
                        $04 : writeln('1.44MB 3½"')
                        else
                            writeln('(', hex(BL, 2), ')')
                    end
                else
                    writeln('fixed disk');
                writeln(DL);
                writeln(DH + 1);
                writeln(cbw(CH, CL shr 6) + 1);
                writeln(CL and $3F);
                if i < $80 then begin
                    writeln('$', hex(mem[ES : DI], 2), ' $'
                        , hex(mem[ES : DI + $0001], 2));
                    writeln(longint(mem[ES : DI + $0002]) shl 16 / tick1 : 0
                        : 1);
                    xbyte2 := mem[ES : DI + $0003];
                    case xbyte2 of
                        $00 : writeln('128');
                        $01 : writeln('256');
                        $02 : writeln('512');
                        $03 : writeln('1024')
                        else
                            writeln('(', hex(xbyte2, 4), ')')
                    end;
                    writeln(mem[ES : DI + $0004]);
                    writeln(mem[ES : DI + $0005]);
                    writeln(mem[ES : DI + $0006]);
                    writeln(mem[ES : DI + $0007]);
                    writeln('$', hex(mem[ES : DI + $0008], 2));
                    writeln(mem[ES : DI + $0009]);
                    writeln(125 * mem[ES : DI + $000A])
                end;
                inc(xbyte1, 13)
            end
        end;
    if xbool then
        writeln('(no disks)')
end;

(****************************************************************************)

procedure page_15;

var
    i : byte;
    j : 0..3;
    k : byte;
    part : array[$00..secsiz - 1] of byte;
    xbool1 : boolean;
    xbool2 : boolean;
    xbyte1 : byte;
    xbyte2 : byte;
    xlong : longint;
    xword : word;
    y : byte;

function getpart(a : byte) : boolean;

var
    parmblk : array[$00..$25] of byte;

begin
    with regs do begin
        AX := $440D;
        BL := a;
        CX := $0860;
        DS := seg(parmblk);
        DX := ofs(parmblk);
        parmblk[$00] := $04;
        MSDOS(regs);
        if nocarry and (parmblk[$01] = 5) then begin
            AX := $440D;
            BL := a;
            CX := $0861;
            DS := seg(parmblk);
            DX := ofs(parmblk);
            fillchar(parmblk, sizeof(parmblk), $00);
            parmblk[$00] := $04;
            parmblk[$08] := $01;
            parmblk[$09] := lo(ofs(part));
            parmblk[$0A] := hi(ofs(part));
            parmblk[$0B] := lo(seg(part));
            parmblk[$0C] := hi(seg(part));
            MSDOS(regs);
            getpart := nocarry
        end else
            getpart := false
    end
end;

begin (* procedure page_15 *)
    caption2('Partition tables');
    if osminor >= 20 then begin
        i := 1;
        xbool1 := false;
        repeat
            if getpart(i) then
                xbool1 := true
            else
                inc(i)
        until xbool1 or (i > 26);
        if xbool1 then begin
            writeln;
            y := wherey + hi(windmin);
            caption3('Drive');
            writeln;
            caption3('Partition');
            writeln;
            caption3('Type');
            writeln;
            caption3('Bootable');
            writeln;
            caption3('Starting cylinder');
            writeln;
            caption3('Starting head');
            writeln;
            caption3('Starting sector');
            writeln;
            caption3('Ending cylinder');
            writeln;
            caption3('Ending head');
            writeln;
            caption3('Ending sector');
            writeln;
            caption3('First partition sector');
            writeln;
            caption3('Sectors in partition');
            writeln;
            repeat
                window(10, y, twidth, tlength - 2);
                drvname(i - 1);
                window(27, y + 1, twidth, tlength - 2);
                clrscr;
                for j := 0 to 3 do begin
                    window(27 + 14 * j, y + 1, 38 + 14 * j, tlength - 2);
                    writeln(j + 1);
                    xword := $01BE + j shl 4;
                    xbyte1 := part[xword + 4];
                    case xbyte1 of
                        $00 : writeln('not used');
                        $01 : writeln('DOS-12');
                        $04 : writeln('DOS-16');
                        $05 : writeln('Ext DOS');
                        $06 : writeln('"Huge" DOS')
                        else
                            writeln('(', hex(xbyte1, 2), ')')
                    end;
                    if xbyte1 > $00 then begin
                        xbyte2 := part[xword];
                        case xbyte2 of
                            $00 : writeln('no');
                            $80 : writeln('yes')
                            else
                                writeln('(', hex(xbyte2, 2), ')')
                        end;
                        writeln(cbw(part[xword + 3], part[xword + 2] shr 6));
                        writeln(part[xword + 1]);
                        writeln(part[xword + 2] and $3F);
                        writeln(cbw(part[xword + 7], part[xword + 6] shr 6));
                        writeln(part[xword + 5]);
                        writeln(part[xword + 6] and $3F);
                        xlong := 0;
                        for k := 11 downto 8 do
                            xlong := xlong shl 8 + part[xword + k];
                        writeln(xlong);
                        xlong := 0;
                        for k := 15 downto 12 do
                            xlong := xlong shl 8 + part[xword + k];
                        writeln(xlong)
                    end else
                        for k := 2 to 10 do
                            writeln('-')
                end;
                repeat
                    inc(i);
                    xbool2 := getpart(i)
                until xbool2 or (i > 26);
                if xbool2 then
                    pause2
            until i > 26
        end else
            writeln('(no fixed disks)')
    end else
        writeln('(not available under this DOS version)')
end;

(****************************************************************************)

procedure page_16;

var
    bootrec : array[0..secsiz - 1] of byte;
    i : 1..26;
    j : word;
    xbool : boolean;
    xbyte : byte;
    xchar : char;
    xword1 : word;
    xword2 : word;
    xword3 : word;
    xword4 : word;
    xword5 : word;
    y : byte;

begin
    y := wherey + hi(windmin);
    window(1, y, twidth div 2, tlength - 2);
    caption1('Boot record');
    writeln;
    xword1 := diskread(currdrv, 0, 1, bootrec);
    if xword1 = $0000 then begin
        caption3('Drive');
        drvname(currdrv);
        writeln;
        media(bootrec[$15]);
        caption3('Sectors/cluster');
        writeln(bootrec[$0D]);
        caption3('Bytes/sector');
        writeln(cbw(bootrec[$0B], bootrec[$0C]));
        caption3('Reserved sectors');
        writeln(cbw(bootrec[$0E], bootrec[$0F]));
        caption3('FAT''s');
        writeln(bootrec[$10]);
        caption3('Sectors/FAT');
        writeln(cbw(bootrec[$16], bootrec[$17]));
        caption3('Root directory entries');
        writeln(cbw(bootrec[$11], bootrec[$12]));
        writeln;
        caption3('Heads');
        writeln(cbw(bootrec[$1A], bootrec[$1B]));
        caption3('Total sectors');
        writeln(cbw(bootrec[$13], bootrec[$14]));
        caption3('Sectors/track');
        writeln(cbw(bootrec[$18], bootrec[$17]));
        caption3('Hidden sectors');
        writeln(cbw(bootrec[$1C], bootrec[$1D]));
        caption3('OEM name and version');
        for i := $03 to $0A do
            write(showchar(chr(bootrec[i])));
        writeln
    end else begin
        writeln('  Can''t read boot record');
        write('  ');
        xbyte := hi(xword1);
        case xbyte of
            $80 : writeln('Attachment failed to respond');
            $40 : writeln('Seek operation failed');
            $20 : writeln('Controller failed');
            $10 : writeln('Data error (bad CRC)');
            $08 : writeln('DMA failure');
            $04 : writeln('Sector not found');
            $03 : writeln('Write-protect fault');
            $02 : writeln('Bad address mark');
            $01 : writeln('Bad command');
            $00 : writeln
            else
                unknown('error', xbyte, 2)
        end;
        write('  ');
        xbyte := lo(xword1);
        case xbyte of
            $00 : writeln('Write-protect error');
            $01 : writeln('Unknown unit');
            $02 : writeln('Drive not ready');
            $03 : writeln('Unknown command');
            $04 : writeln('Data error (bad CRC)');
            $05 : writeln('Bad request structure length');
            $06 : writeln('Seek error');
            $07 : writeln('Unknown media type');
            $08 : writeln('Sector not found');
            $09 : writeln('Printer out of paper');
            $0A : writeln('Write fault');
            $0B : writeln('Read fault');
            $0C : writeln('General failure')
            else
                unknown('error', xbyte, 2)
        end
    end;
    window(1 + twidth div 2, y, twidth, tlength - 2);
    caption1('DOS disk parameters');
    writeln;
    if osminor >= 10 then begin
        i := 1;
        xbool := false;
        xword1 := memw[devseg : devofs + $0018];
        xword2 := memw[devseg : devofs + $0016];
        repeat
            window(1 + twidth div 2, y + 1, twidth, tlength - 2);
            caption3('Drive');
            drvname(i - 1);
            writeln;
            xword3 := memw[xword1 : xword2 + $0047];
            xword4 := memw[xword1 : xword2 + $0045];
            media(mem[xword3 : xword4 + $0016]);
            caption3('Sectors/cluster');
            writeln(mem[xword3 : xword4 + $0004] + 1);
            caption3('Bytes/sector');
            writeln(memw[xword3 : xword4 + $0002]);
            caption3('Reserved sectors');
            writeln(memw[xword3 : xword4 + $0006]);
            caption3('FAT''s');
            writeln(mem[xword3 : xword4 + $0008]);
            caption3('Sectors/FAT');
            writeln(mem[xword3 : xword4 + $000F]);
            caption3('Root directory entries');
            writeln(memw[xword3 : xword4 + $0009]);
            writeln;
            caption3('DPB valid');
            yesorno2(mem[xword3 : xword4 + $0017] < $FF);
            caption3('Current directory');
            j := xword2;
            xchar := chr(mem[xword1 : j]);
            while xchar > #0 do begin
                write(xchar);
                inc(j);
                xchar := chr(mem[xword1 : j])
            end;
            writeln;
            caption3('Device header');
            segofs2(memw[xword3 : xword4 + $0014]
                , memw[xword3 : xword4 + $0012]);
            caption3('Unit within driver');
            writeln(mem[xword3 : xword4 + $0001]);
            caption3('Clusters');
            writeln(memw[xword3 : xword4 + $000D] - 1);
            caption3('Cluster to sector shift');
            writeln(mem[xword3 : xword4 + $0005]);
            caption3('Root directory sector');
            writeln(memw[xword3 : xword4 + $0010]);
            caption3('First data sector');
            writeln(memw[xword3 : xword4 + $000B]);
            caption3('Next DPB');
            xword5 := memw[xword3 : xword4 + $0018];
            segofs2(memw[xword3 : xword4 + $001A], xword5);
            if xword5 < $FFFF then begin
                write('  ');
                pause2;
                clrscr;
                inc(i);
                inc(xword2, $51)
            end else
                xbool := true
        until xbool
    end else
        writeln('(not available under this DOS version)')
end;